home *** CD-ROM | disk | FTP | other *** search
/ Young Minds / Young Minds Interactive CD-ROM.ISO / dungeon / np2.f < prev    next >
Encoding:
Text File  |  1987-09-16  |  4.7 KB  |  223 lines
  1. C GETOBJ--    FIND OBJ DESCRIBED BY ADJ, NAME PAIR
  2. C
  3. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C DECLARATIONS
  8. C
  9. C THIS ROUTINE DETAILS ON BIT 3 OF PRSFLG
  10. C
  11.     INTEGER FUNCTION GETOBJ(OIDX,AIDX,SPCOBJ)
  12.     IMPLICIT INTEGER(A-Z)
  13.     LOGICAL THISIT,GHERE,LIT,CHOMP
  14. #include "parser.h"
  15. #include "gamestate.h"
  16. C
  17. C MISCELLANEOUS VARIABLES
  18. C
  19.     COMMON /STAR/ MBASE,STRBIT
  20. #include "debug.h"
  21. #include "objects.h"
  22. #include "oflags.h"
  23. #include "advers.h"
  24. #include "vocab.h"
  25. C GETOBJ, PAGE 2
  26. C
  27. #ifdef debug
  28.     DFLAG=and(PRSFLG, 8).NE.0
  29. #endif debug
  30.     CHOMP=.FALSE.
  31.     AV=AVEHIC(WINNER)
  32.     OBJ=0
  33. C                        !ASSUME DARK.
  34.     IF(.NOT.LIT(HERE)) GO TO 200
  35. C                        !LIT?
  36. C
  37.     OBJ=SCHLST(OIDX,AIDX,HERE,0,0,SPCOBJ)
  38. C                        !SEARCH ROOM.
  39. #ifdef debug
  40.     IF(DFLAG) PRINT 10,OBJ
  41. 10    FORMAT(' SCHLST- ROOM SCH ',I6)
  42. #endif debug
  43.     IF(OBJ) 1000,200,100
  44. C                        !TEST RESULT.
  45. 100    IF((AV.EQ.0).OR.(AV.EQ.OBJ).OR.
  46. &        (and(OFLAG2(OBJ),FINDBT).NE.0)) GO TO 200
  47.     IF(OCAN(OBJ).EQ.AV) GO TO 200
  48. C                        !TEST IF REACHABLE.
  49.     CHOMP=.TRUE.
  50. C                        !PROBABLY NOT.
  51. C
  52. 200    IF(AV.EQ.0) GO TO 400
  53. C                        !IN VEHICLE?
  54.     NOBJ=SCHLST(OIDX,AIDX,0,AV,0,SPCOBJ)
  55. C                        !SEARCH VEHICLE.
  56. #ifdef debug
  57.     IF(DFLAG) PRINT 20,NOBJ
  58. 20    FORMAT(' SCHLST- VEH SCH  ',I6)
  59. #endif debug
  60.     IF(NOBJ) 1100,400,300
  61. C                        !TEST RESULT.
  62. 300    CHOMP=.FALSE.
  63. C                        !REACHABLE.
  64.     IF(OBJ.EQ.NOBJ) GO TO 400
  65. C                        !SAME AS BEFORE?
  66.     IF(OBJ.NE.0) NOBJ=-NOBJ
  67. C                        !AMB RESULT?
  68.     OBJ=NOBJ
  69. C
  70. 400    NOBJ=SCHLST(OIDX,AIDX,0,0,WINNER,SPCOBJ)
  71. C                        !SEARCH ADVENTURER.
  72. #ifdef debug
  73.     IF(DFLAG) PRINT 30,NOBJ
  74. 30    FORMAT(' SCHLST- ADV SCH  ',I6)
  75. #endif debug
  76.     IF(NOBJ) 1100,600,500
  77. C                        !TEST RESULT
  78. 500    IF(OBJ.NE.0) NOBJ=-NOBJ
  79. C                        !AMB RESULT?
  80. 1100    OBJ=NOBJ
  81. C                        !RETURN NEW OBJECT.
  82. 600    IF(CHOMP) OBJ=-10000
  83. C                        !UNREACHABLE.
  84. 1000    GETOBJ=OBJ
  85. C
  86.     IF(GETOBJ.NE.0) GO TO 1500
  87. C                        !GOT SOMETHING?
  88.     DO 1200 I=STRBIT+1,OLNT
  89. C                        !NO, SEARCH GLOBALS.
  90.       IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 1200
  91.       IF(.NOT.GHERE(I,HERE)) GO TO 1200
  92. C                        !CAN IT BE HERE?
  93.       IF(GETOBJ.NE.0) GETOBJ=-I
  94. C                        !AMB MATCH?
  95.       IF(GETOBJ.EQ.0) GETOBJ=I
  96. 1200    CONTINUE
  97. C
  98. 1500    CONTINUE
  99. C                        !END OF SEARCH.
  100. #ifdef debug
  101.     IF(DFLAG) PRINT 40,GETOBJ
  102. 40    FORMAT(' SCHLST- RESULT   ',I6)
  103. #endif debug
  104.     RETURN
  105.     END
  106. C SCHLST--    SEARCH FOR OBJECT
  107. C
  108. C DECLARATIONS
  109. C
  110.     INTEGER FUNCTION SCHLST(OIDX,AIDX,RM,CN,AD,SPCOBJ)
  111.     IMPLICIT INTEGER(A-Z)
  112.     LOGICAL THISIT,QHERE,NOTRAN,NOVIS
  113. C
  114.     COMMON /STAR/ MBASE,STRBIT
  115. #include "objects.h"
  116. #include "oflags.h"
  117. C
  118. C FUNCTIONS AND DATA
  119. C
  120.     NOTRAN(O)=(and(OFLAG1(O),TRANBT).EQ.0).AND.
  121. &        (and(OFLAG2(O),OPENBT).EQ.0)
  122.     NOVIS(O)=(and(OFLAG1(O),VISIBT).EQ.0)
  123. C
  124.     SCHLST=0
  125. C                        !NO RESULT.
  126.     DO 1000 I=1,OLNT
  127. C                        !SEARCH OBJECTS.
  128.       IF(NOVIS(I).OR.
  129. &        (((RM.EQ.0).OR.(.NOT.QHERE(I,RM))).AND.
  130. &         ((CN.EQ.0).OR.(OCAN(I).NE.CN)).AND.
  131. &         ((AD.EQ.0).OR.(OADV(I).NE.AD)))) GO TO 1000
  132.       IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 200
  133.       IF(SCHLST.NE.0) GO TO 2000
  134. C                        !GOT ONE ALREADY?
  135.       SCHLST=I
  136. C                        !NO.
  137. C
  138. C IF OPEN OR TRANSPARENT, SEARCH THE OBJECT ITSELF.
  139. C
  140. 200      IF(NOTRAN(I)) GO TO 1000
  141. C
  142. C SEARCH IS CONDUCTED IN REVERSE.  ALL OBJECTS ARE CHECKED TO
  143. C SEE IF THEY ARE AT SOME LEVEL OF CONTAINMENT INSIDE OBJECT 'I'.
  144. C IF THEY ARE AT LEVEL 1, OR IF ALL LINKS IN THE CONTAINMENT
  145. C CHAIN ARE OPEN, VISIBLE, AND HAVE SEARCHME SET, THEY CAN QUALIFY
  146. C AS A POTENTIAL MATCH.
  147. C
  148.       DO 500 J=1,OLNT
  149. C                        !SEARCH OBJECTS.
  150.         IF(NOVIS(J).OR. (.NOT.THISIT(OIDX,AIDX,J,SPCOBJ)))
  151. &        GO TO 500
  152.         X=OCAN(J)
  153. C                        !GET CONTAINER.
  154. 300        IF(X.EQ.I) GO TO 400
  155. C                        !INSIDE TARGET?
  156.         IF(X.EQ.0) GO TO 500
  157. C                        !INSIDE ANYTHING?
  158.         IF(NOVIS(X).OR.NOTRAN(X).OR.
  159. &        (and(OFLAG2(X),SCHBT).EQ.0)) GO TO 500
  160.         X=OCAN(X)
  161. C                        !GO ANOTHER LEVEL.
  162.         GO TO 300
  163. C
  164. 400        IF(SCHLST.NE.0) GO TO 2000
  165. C                        !ALREADY GOT ONE?
  166.         SCHLST=J
  167. C                        !NO.
  168. 500      CONTINUE
  169. C
  170. 1000    CONTINUE
  171.     RETURN
  172. C
  173. 2000    SCHLST=-SCHLST
  174. C                        !AMB RETURN.
  175.     RETURN
  176. C
  177.     END
  178. C
  179. C THISIT--    VALIDATE OBJECT VS DESCRIPTION
  180. C
  181. C DECLARATIONS
  182. C
  183.     LOGICAL  FUNCTION  THISIT(OIDX,AIDX,OBJ,SPCOBJ)
  184.     IMPLICIT INTEGER(A-Z)
  185.     LOGICAL  NOTEST
  186. #include "vocab.h"
  187. C
  188. C FUNCTIONS AND DATA
  189. C
  190.     NOTEST(O)=(O.LE.0).OR.(O.GE.R50MIN)
  191. C
  192. C    THE FOLLOWING DATA STATEMENT USED RADIX-50 NOTATION (R50MIN/1RA/)
  193. C       IN RADIX-50 NOTATION, AN "A" IN THE FIRST POSITION IS
  194. C       ENCODED AS 1*40*40 = 1600.
  195. C
  196.     DATA R50MIN/1600/
  197. C
  198.     THISIT=.FALSE.
  199. C                        !ASSUME NO MATCH.
  200.     IF((SPCOBJ.NE.0).AND.(OBJ.EQ.SPCOBJ)) GO TO 500
  201. C
  202. C CHECK FOR OBJECT NAMES
  203. C
  204.     I=OIDX+1
  205. 100    I=I+1
  206.     IF(NOTEST(OVOC(I))) RETURN
  207. C                        !IF DONE, LOSE.
  208.     IF(OVOC(I).NE.OBJ) GO TO 100
  209. C                        !IF FAIL, CONT.
  210. C
  211.     IF(AIDX.EQ.0) GO TO 500
  212. C                        !ANY ADJ?
  213.     I=AIDX+1
  214. 200    I=I+1
  215.     IF(NOTEST(AVOC(I))) RETURN
  216. C                        !IF DONE, LOSE.
  217.     IF(AVOC(I).NE.OBJ) GO TO 200
  218. C                        !IF FAIL, CONT.
  219. C
  220. 500    THISIT=.TRUE.
  221.     RETURN
  222.     END
  223.